PC Plus SuperCD (UK) 1994 June/PC Plus Super CD coverdisc Issue 93 June 1994.iso/suprdisk/button/directry.frm

Visual Basic Form | 1994-04-12 | 6.9 KB | 241 lines

VERSION 2.00
Begin Form Directory
   BackColor       =   &H00FFFFFF&
   BorderStyle     =   3  'Fixed Double
   Caption         =   "Open"
   ClientHeight    =   3795
   ClientLeft      =   1545
   ClientTop       =   1965
   ClientWidth     =   6210
   ControlBox      =   0   'False
   FillStyle       =   3  'Vertical Line
   FontBold        =   -1  'True
   FontItalic      =   0   'False
   FontName        =   "System"
   FontSize        =   9.75
   FontStrikethru  =   0   'False
   FontUnderline   =   0   'False
   Height          =   4200
   Icon            =   0
   Left            =   1485
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3795
   ScaleWidth      =   6210
   Top             =   1620
   Width           =   6330
   Begin FileListBox File1
      Height          =   1980
      Left            =   2700
      Pattern         =   "*.txt"
      TabIndex        =   2
      Top             =   1260
      Width           =   1785
   End
   Begin DirListBox Dir1
      Height          =   1605
      Left            =   450
      TabIndex        =   5
      Top             =   1260
      Width           =   2100
   End
   Begin CommandButton Command1
      Caption         =   "&Refresh"
      Height          =   420
      Left            =   4650
      TabIndex        =   10
      Top             =   1305
      Width           =   1140
   End
   Begin CommandButton cmdOk
      Caption         =   "OK"
      Default         =   -1  'True
      Height          =   420
      Left            =   4650
      TabIndex        =   8
      Top             =   2070
      Width           =   1125
   End
   Begin TextBox text1
      Height          =   345
      Left            =   1530
      TabIndex        =   1
      Text            =   "*.txt"
      Top             =   795
      Width           =   4140
   End
   Begin CommandButton cmdCancel
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   420
      Left            =   4650
      TabIndex        =   9
      Top             =   2790
      Width           =   1125
   End
   Begin DriveListBox drvDrives
      Height          =   315
      Left            =   450
      TabIndex        =   7
      Top             =   2925
      Width           =   2100
   End
   Begin Label lblFileName
      BackStyle       =   0  'Transparent
      Caption         =   "File &Name:"
      Height          =   240
      Left            =   480
      TabIndex        =   0
      Top             =   870
      Width           =   975
   End
   Begin Label lblDirectories
      BackStyle       =   0  'Transparent
      Caption         =   "&Directory:"
      Height          =   240
      Left            =   480
      TabIndex        =   3
      Top             =   405
      Width           =   885
   End
   Begin Label lblCurrentDir
      BackStyle       =   0  'Transparent
      Height          =   225
      Left            =   1530
      TabIndex        =   4
      Top             =   420
      Width           =   4140
   End
   Begin Label lblDrives
      BackStyle       =   0  'Transparent
      Caption         =   "Dri&ves:"
      Height          =   255
      Left            =   3555
      TabIndex        =   6
      Top             =   2820
      Width           =   765
   End
Const FILECLICK = False
Const DIRCLICK = 1
Dim LastClick As Integer
Sub cmdCancel_Click ()
    ' Set the file name text box to null.
    ' By checking the text property of this text box,
    ' other procedures can tell if Cancel has been
    ' selected.
    Directory.text1 = ""
    '
    ' Hide the form
    Directory.Hide
End Sub
Sub cmdOK_Click ()
Dim Msg As String
On Error Resume Next
    If LastClick = DIRCLICK Then
        Dir1.Path = Dir1.List(Dir1.ListIndex)
        Exit Sub
    End If
    On Error Resume Next
    'if a full path has been entered in the text box then
    'set the directory label to ""
    If InStr(text1, "\") Then
        lblCurrentDir = ""
    Else
        GroupName = Left$(text1, InStr(text1, "_") - 1)
    End If
    If Left$(text1, 1) = "*" Then Error 64
    If Len(lblCurrentDir) <> 0 Then
        If Right$(lblCurrentDir, 1) = "\" Then
            text1 = lblCurrentDir & text1
        Else
            text1 = lblCurrentDir & "\" & text1
        End If
    End If
    If Err Then
        MsgBox Error$, 0, Temp$
        text1.SelStart = 0
        text1.SelLength = Len(text1)
    Else
        Directory.Hide
    End If
End Sub
Sub Command1_Click ()
    drvDrives.Refresh
    Dir1.Refresh
    file1.Refresh
End Sub
Sub Dir1_Change ()
    ' propogate directory changes to other controls
    file1.Path = Dir1.Path
    lblCurrentDir.Caption = Dir1.Path
    text1 = file1.Pattern
    file1.SetFocus
End Sub
Sub Dir1_Click ()
    LastClick = DIRCLICK
End Sub
Sub drvDrives_Change ()
    ' change the Dir1 control path, it will
    ' pass the change on to the File1 control
    Dir1.Path = drvDrives.Drive
    ChDrive (drvDrives.Drive)
End Sub
Sub File1_Click ()
    ' echo the selected name in the Text box
    LastClick = FILECLICK
    text1 = file1.FileName
End Sub
Sub File1_DblClick ()
    ' we have a final selection from the File Save dialog
    'text1 = File1.FileName
    cmdOK_Click
End Sub
Sub File1_PathChange ()
    Dir1.Path = file1.Path
    drvDrives.Drive = file1.Path
End Sub
Sub File1_PatternChange ()
    'Show the current search pattern in the text1 control
    text1 = file1.Pattern
    Dir1.Path = file1.Path
End Sub
Sub Form_Activate ()
    If Len(CurrentDirectory) > 0 Then Dir1.Path = CurrentDirectory
    ' initialize file controls
    file1.Refresh
    file1.Pattern = "*_B.DAT"
    text1 = file1.Pattern
    Directory.text1.SelStart = 0
    Directory.text1.SelLength = Len(Directory.text1)
    HelpItem = 14
End Sub
Sub Form_KeyDown (KeyCode As Integer, Shift As Integer)
    If KeyCode = &H70 Then Cheap_Help Format$(HelpItem)
End Sub
Sub Form_Load ()
    Position_Form Directory
    lblCurrentDir.Caption = Dir1.Path
    KeyPreview = True
End Sub
Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer)
    cmdCancel_Click
    Cancel = True
End Sub
Sub Form_Unload (Cancel As Integer)
    'Cancel = True   ' Don't unload form, just hide it
    'Call cmdCancel_Click
End Sub
Sub Text1_Change ()
    ' Disable OK button if no filename.
    cmdOK.Enabled = (Len(text1) > 0)
End Sub
Sub text1_GotFocus ()
    text1.SelStart = 0
    text1.SelLength = Len(text1)
End Sub
Sub Text1_KeyPress (KeyAscii As Integer)
    LastClick = FILECLICK
End Sub